;;; -*- Mode:LISP; Package:(TUBE GLOBAL); Base:10 -*-

;;; TUBES ARE BIDRECTIONAL COMMUNICATIONS STREAMS. YOU CAN TALK
;;; IN ONE END AND LISTEN ON THE OTHER. AKA TIN-CAN TELEPHONE.

(DEFVAR *REMOTE-TUBES* NIL)

(ADD-INITIALIZATION "TUBE"
                    '(PROCESS-RUN-FUNCTION "TUBE SERVER" 'SETUP-REMOTE-TUBE)
                    NIL
                    'CHAOS:SERVER-ALIST)

(defvar *remote-TUBE-unique-check-p* t)

(DEFUN SETUP-REMOTE-TUBE (&AUX STREAM CONN PKT ST N)
  (SETQ STREAM (CHAOS:OPEN-STREAM NIL "TUBE"))
  (SETQ CONN (SEND STREAM :CONNECTION))
  (SETQ PKT (CHAOS:CONN-READ-PKTS CONN))
  (COND ((NULL PKT)
         (CHAOS:REJECT CONN "INTERNAL ERROR"))
        ((NOT (SETQ N (STRING-SEARCH-CHAR #\SPACE (SETQ ST (CHAOS:PKT-STRING PKT)))))
         (CHAOS:REJECT CONN "NO TUBE NAME GIVEN"))
        ((and (GET-REMOTE-TUBE (SETQ ST (string-trim " " (SUBSTRING ST N))))
              *remote-TUBE-unique-check-p*)
         (CHAOS:REJECT CONN "Already have a TUBE by that name here"))
        ('ELSE
         (PUSH (LIST ST STREAM) *REMOTE-TUBES*)
         (CHAOS:ACCEPT CONN))))


(DEFUN GET-REMOTE-TUBE (NAME)
  (if *remote-TUBE-unique-check-p*
      (CADR (ASS #'STRING-EQUAL NAME *REMOTE-TUBES*))
    (VALUES-LIST (MAPCAR #'CADR (SUBSET #'(LAMBDA (X) (STRING-EQUAL (CAR X) NAME)) *REMOTE-TUBES*)))))


(DEFVAR *LOCAL-TUBES* NIL)

(DEFUN OPEN-TUBE (HOST NAME)
  (CHECK-TYPE NAME STRING)
  (LET ((S (IF (EQ SI:LOCAL-HOST (SI:PARSE-HOST HOST))
               (OPEN-TUBE-TO-SELF NAME)
             (CHAOS:OPEN-STREAM HOST (STRING-APPEND "TUBE " NAME)))))
    (PUSH (LIST HOST NAME S) *LOCAL-TUBES*)
    S))

(DEFFLAVOR LOCAL-TUBE
           (INPUT-IO-BUFFER
            (UNTYI-CHAR NIL)
            OUTPUT-IO-BUFFER)
           ()
  :INITABLE-INSTANCE-VARIABLES)

(DEFUN MAKE-LOCAL-TUBE ()
  (LET ((I (TV:MAKE-IO-BUFFER 100))
        (O (TV:MAKE-IO-BUFFER 100)))
    (VALUES (MAKE-INSTANCE 'LOCAL-TUBE
                           :INPUT-IO-BUFFER I
                           :OUTPUT-IO-BUFFER O)
            (MAKE-INSTANCE 'LOCAL-TUBE
                           :INPUT-IO-BUFFER O
                           :OUTPUT-IO-BUFFER I))))


(DEFMETHOD (LOCAL-TUBE :TYI) ()
  (COND (UNTYI-CHAR
         (PROG1 UNTYI-CHAR (SETQ UNTYI-CHAR NIL)))
        ('ELSE
         (TV:IO-BUFFER-GET INPUT-IO-BUFFER))))

(DEFMETHOD (LOCAL-TUBE :TYI-NO-HANG) ()
  (COND (UNTYI-CHAR
         (PROG1 UNTYI-CHAR (SETQ UNTYI-CHAR NIL)))
        ('ELSE
         (TV:IO-BUFFER-GET INPUT-IO-BUFFER T))))

(DEFMETHOD (LOCAL-TUBE :UNTYI) (C)
  (SETQ UNTYI-CHAR C))

(DEFMETHOD (LOCAL-TUBE :TYO) (C)
  (TV:IO-BUFFER-PUT OUTPUT-IO-BUFFER C))

(DEFMETHOD (LOCAL-TUBE :STRING-OUT) (&OPTIONAL ARG1 &REST ARGS)
  (STREAM-DEFAULT-HANDLER SELF :STRING-OUT ARG1 ARGS))

(DEFUN OPEN-TUBE-TO-SELF (NAME)
  (IF (AND *remote-TUBE-unique-check-p*
           (GET-REMOTE-TUBE NAME))
      (FERROR NIL "Already have a TUBE by that name"))
  (MULTIPLE-VALUE-BIND (A B)
      (MAKE-LOCAL-TUBE)
    (PUSH (LIST NAME B) *REMOTE-TUBES*)
    A))


(COMPILE-FLAVOR-METHODS LOCAL-TUBE)
